MODULE SORT_VEC
!
! sort_vector is a generic call (with overloading of the type of
! the 3rd argument vector to be sorted.
! IF j < 0, then it performs a reverse ordering.
! IF j >=0, then it performs a normal ordering

   parameter (charlen=19)
   INTERFACE sort_vector     
     module procedure  sort_real_with_index
     module procedure  sort_char_with_index
     module procedure  sort_real
     module procedure  sort_integer
     module procedure  sort_double
   END INTERFACE sort_vector   
   
   type real_with_ind
     real*4  vet
     integer ind
   end type real_with_ind
   
   type char_with_ind
     character*(charlen) vet
     integer ind
   end type char_with_ind

CONTAINS
   
   

subroutine sort_real_with_index(j,nd,s)
!
! Programmed on Jun-14th-2013 by F.M.
!
! in this routine, we suppose to have the values to be sorted in s(i).vet.
! We memorize the startin index of s.vet in s.ind. Then we oreder s(i) by
! the values of s.vet, carrying with us the starting index in s.ind.
! As a consequence, the OUTPUT vector s(i).ind says that the element whose initial
! position is memorized in s(i).ind, should go to the i-th position.
!

type (real_with_ind), allocatable  :: s(:)


!c ordina il vettore in ordine crescente
type (real_with_ind) ::  vetm
! real*4, intent(INOUT) :: vet(*)
integer, intent(IN)   :: nd,j
integer :: i,k

! memorize the starting index in ind
  do i=1,nd
    s(i).ind = i
  enddo


! if j<0, chenge the sign to all the values
if(j .lt. 0)then
  do i=1,nd
    s(i).vet = -s(i).vet
  enddo
endif

! move min to front, as sentinel
k = 1
do i = 2,nd
  if (s(i).vet .lt. s(k).vet) k = i
enddo
vetm=s(1)
s(1)=s(k)
s(k)=vetm

! insertion sort with sentinel
do i = 2,nd
       k=i
	   do while(s(k).vet .lt. s(k-1).vet)
         vetm=s(k-1)
         s(k-1)=s(k)
         s(k)=vetm
		 k=k-1
	   end do   
enddo

! if j<0, chenge the sign to all the values, going back to the original one.
if(j .lt. 0)then
  do i=1,nd
    s(i).vet = -s(i).vet
  enddo
endif

return
end subroutine

!================================================== 
   
subroutine sort_char_with_index(j,nd,nch,sc)
!
! Programmed on July-7th-2013 by F.M.
! 
!
! in this routine, we suppose to have the values to be sorted in s(i).vet.
! We memorize the starting index of s.vet in s.ind. Then we oreder s(i) by
! the values of s.vet, carrying with us the starting index in s.ind.
! As a consequence, the OUTPUT vector s(i).ind says that the element whose initial
! position is memorized in s(i).ind, should go to the i-th position.
!
! s(i).vet is a character string. nch says hoe many initial (left) chars are 
! used to order the vector

type (char_with_ind), allocatable  :: sc(:)


!c ordina il vettore in ordine crescente
type (char_with_ind)  ::  vetm
! real*4, intent(INOUT) :: vet(*)
integer, intent(IN)   :: nd,j,nch
integer :: i,k

! memorize the starting index in ind
  do i=1,nd
    sc(i).ind = i
  enddo


! if j<0, write operation is not possible
if(j .lt. 0)then
!  do i=1,nd
!    s(i).vet = -s(i).vet
!  enddo
   write(*,*)' invers ordering of char vectors is not supported'
   pause
   stop
 endif

! move min to front, as sentinel
k = 1
do i = 2,nd
  if (sc(i).vet(1:nch) .lt. sc(k).vet(1:nch)) k = i
enddo
vetm=sc(1)
sc(1)=sc(k)
sc(k)=vetm

! insertion sort with sentinel
do i = 2,nd
       k=i
	   do while(sc(k).vet(1:nch) .lt. sc(k-1).vet(1:nch))
         vetm=sc(k-1)
         sc(k-1)=sc(k)
         sc(k)=vetm
		 k=k-1
	   end do   
enddo

! if j<0, chenge the sign to all the values, going back to the original one.
!
! INVERS ORDERING NOT SUPPORTED FOR CHARACTER VECTORS
!if(j .lt. 0)then
!  do i=1,nd
!    s(i).vet = -s(i).vet
!  enddo
!endif

return
end subroutine

!================================================== 
   
     
subroutine sort_real(j,nd,vet)
!c ordina il vettore in ordine crescente
real*4, intent(INOUT) :: vet(*)
integer, intent(IN)   :: nd,j
real*4 vetm
integer :: i,k

! if j<0, chenge the sign to all the values
if(j .lt. 0)then
  do i=1,nd
    vet(i) = -vet(i)
  enddo
endif

! move min to front, as sentinel
k = 1
do i = 2,nd
  if (vet(i) .lt. vet(k)) k = i
enddo
vetm=vet(1)
vet(1)=vet(k)
vet(k)=vetm

! insertion sort with sentinel
do i = 2,nd
       k=i
	   do while(vet(k) .lt. vet(k-1))
         vetm=vet(k-1)
         vet(k-1)=vet(k)
         vet(k)=vetm
		 k=k-1
	   end do   
enddo

! if j<0, chenge the sign to all the values, going back to the original one.
if(j .lt. 0)then
  do i=1,nd
    vet(i) = -vet(i)
  enddo
endif

return
end subroutine

!==============================================

subroutine sort_integer(j,nd,vet)
!c ordina il vettore in ordine crescente
integer, intent(INOUT) :: vet(*)
integer, intent(IN)   :: nd,j
integer :: vetm
integer :: i,k

! if j<0, chenge the sign to all the values
if(j .lt. 0)then
  do i=1,nd
    vet(i) = -vet(i)
  enddo
endif

! move min to front, as sentinel
k = 1
do i = 2,nd
  if (vet(i) .lt. vet(k)) k = i
enddo
vetm=vet(1)
vet(1)=vet(k)
vet(k)=vetm

! insertion sort with sentinel
do i = 2,nd
       k=i
	   do while(vet(k) .lt. vet(k-1))
         vetm=vet(k-1)
         vet(k-1)=vet(k)
         vet(k)=vetm
		 k=k-1
	   end do   
enddo


! if j<0, chenge the sign to all the values, going back to the original one.
if(j .lt. 0)then
  do i=1,nd
    vet(i) = -vet(i)
  enddo
endif


return
end subroutine

!==============================================


subroutine sort_double(j,nd,vet)
!c ordina il vettore in ordine crescente
real*8, intent(INOUT) :: vet(*)
integer, intent(IN)   :: nd,j
real*8 vetm
integer :: i,k

! if j<0, chenge the sign to all the values
if(j .lt. 0)then
  do i=1,nd
    vet(i) = -vet(i)
  enddo
endif

! move min to front, as sentinel
k = 1
do i = 2,nd
  if (vet(i) .lt. vet(k)) k = i
enddo
vetm=vet(1)
vet(1)=vet(k)
vet(k)=vetm

! insertion sort with sentinel
do i = 2,nd
       k=i
	   do while(vet(k) .lt. vet(k-1))
         vetm=vet(k-1)
         vet(k-1)=vet(k)
         vet(k)=vetm
		 k=k-1
	   end do   
enddo


! if j<0, chenge the sign to all the values, going back to the original one.
if(j .lt. 0)then
  do i=1,nd
    vet(i) = -vet(i)
  enddo
endif

return
end subroutine
!==============================================



END MODULE